home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / ddot.f < prev    next >
Text File  |  1989-08-17  |  4KB  |  96 lines
  1. c   imsl routine name   - vbla=ddot                                     vbdd0010
  2. c
  3. c-----------------------------------------------------------------------
  4. c
  5. c   computer            - vax/double
  6. c
  7. c   latest revision     - january 1, 1978
  8. c
  9. c   purpose             - compute double precision dot product
  10. c
  11. c   usage               - function ddot (n,dx,incx,dy,incy)
  12. c
  13. c   arguments    ddot   - double precision sum from i=1 to n of
  14. c                           x(i)*y(i). (output)
  15. c                           x(i) and y(i) refer to specific elements
  16. c                           of dx and dy, respectively. see incx and
  17. c                           incy argument descriptions.
  18. c                n      - length of vectors x and y. (input)
  19. c                dx     - double precision vector of length
  20. c                           max(n*iabs(incx),1). (input)
  21. c                incx   - displacement between elements of dx. (input)
  22. c                           x(i) is defined to be..
  23. c                           dx(1+(i-1)*incx) if incx.ge.0 or
  24. c                           dx(1+(i-n)*incx) if incx.lt.0.
  25. c                dy     - double precision vector of length
  26. c                           max(n*iabs(incy),1). (input)
  27. c                incy   - displacement between elements of dy. (input)
  28. c                           y(i) is defined to be..
  29. c                           dy(1+(i-1)*incy) if incy.ge.0 or
  30. c                           dy(1+(i-n)*incy) if incy.lt.0.
  31. c
  32. c   precision/hardware  - double/all
  33. c
  34. c   reqd. imsl routines - none required
  35. c
  36. c   notation            - information on special notation and
  37. c                           conventions is available in the manual
  38. c                           introduction or through imsl routine uhelp
  39. c
  40. c   copyright           - 1978 by imsl, inc. all rights reserved.
  41. c
  42. c   warranty            - imsl warrants only that imsl testing has been
  43. c                           applied to this code. no other warranty,
  44. c                           expressed or implied, is applicable.
  45. c
  46. c-----------------------------------------------------------------------
  47. c
  48.       double precision function ddot (n,dx,incx,dy,incy)
  49. c
  50. c                                  specifications for arguments
  51.       double precision   dx(1),dy(1)
  52.       integer            n,incx,incy
  53. c                                  specifications for local variables
  54.       integer            i,m,mp1,ns,ix,iy
  55. c                                  first executable statement
  56.       ddot = 0.d0
  57.       if (n.le.0) return
  58.       if (incx.eq.incy) if (incx-1) 5,15,35
  59.     5 continue
  60. c                                  code for unequal or nonpositive
  61. c                                    increments.
  62.       ix = 1
  63.       iy = 1
  64.       if (incx.lt.0) ix = (-n+1)*incx+1
  65.       if (incy.lt.0) iy = (-n+1)*incy+1
  66.       do 10 i=1,n
  67.          ddot = ddot+dx(ix)*dy(iy)
  68.          ix = ix+incx
  69.          iy = iy+incy
  70.    10 continue
  71.       return
  72. c                                  code for both increments equal to 1.
  73. c                                    clean-up loop so remaining vector
  74. c                                    length is a multiple of 5.
  75.    15 m = n-(n/5)*5
  76.       if (m.eq.0) go to 25
  77.       do 20 i=1,m
  78.          ddot = ddot+dx(i)*dy(i)
  79.    20 continue
  80.       if (n.lt.5) return
  81.    25 mp1 = m+1
  82.       do 30 i=mp1,n,5
  83.          ddot = ddot+dx(i)*dy(i)+dx(i+1)*dy(i+1)+dx(i+2)*dy(i+2)+dx(i
  84.      1   +3)*dy(i+3)+dx(i+4)*dy(i+4)
  85.    30 continue
  86.       return
  87. c                                  code for positive equal increments
  88. c                                    .ne.1.
  89.    35 continue
  90.       ns = n*incx
  91.       do 40 i=1,ns,incx
  92.          ddot = ddot+dx(i)*dy(i)
  93.    40 continue
  94.       return
  95.       end
  96.